home *** CD-ROM | disk | FTP | other *** search
/ Aminet 37 / Aminet 37 (2000)(Schatztruhe)[!][Jun 2000].iso / Aminet / dev / src / emog.lha / egen.e < prev    next >
Encoding:
Text File  |  2000-03-07  |  27.8 KB  |  891 lines
  1. /* -- ----------------------------------------------------- -- *
  2.  * -- Name........: egen.e                                  -- *
  3.  * -- Description.: Here we got the source generator which  -- *
  4.  * --               runs through the syntax tree and        -- *
  5.  * --               produces the E source according to it.  -- *
  6.  * -- Author......: Daniel Kasmeroglu                       -- *
  7.  * -- E-Mail......: raptor@cs.tu-berlin.de                  -- *
  8.  * --               daniel.kasmeroglu@daimlerchrysler.com   -- *
  9.  * -- Date........: 05-Mar-00                               -- *
  10.  * -- Version.....: 0.1                                     -- *
  11.  * -- ----------------------------------------------------- -- */
  12.  
  13.  
  14. /* -- ----------------------------------------------------- -- *
  15.  * --                         Options                       -- *
  16.  * -- ----------------------------------------------------- -- */
  17.  
  18. OPT MODULE
  19.  
  20.  
  21. /* -- ----------------------------------------------------- -- *
  22.  * --                         Modules                       -- *
  23.  * -- ----------------------------------------------------- -- */
  24.  
  25. MODULE  'exec/lists'    ,
  26.     '*tools'        ,
  27.     '*absy'
  28.  
  29.  
  30. /* -- ----------------------------------------------------- -- *
  31.  * --                        Constants                      -- *
  32.  * -- ----------------------------------------------------- -- */
  33.  
  34. CONST   ALIGN_CONSTANT  = 30 ,
  35.     ALIGN_COMPONENT = 20 ,
  36.     ALIGN_COMPTYPE  = 20
  37.  
  38.  
  39. /* -- ----------------------------------------------------- -- *
  40.  * --                        Functions                      -- *
  41.  * -- ----------------------------------------------------- -- */
  42.  
  43. ->> PROC generateE()
  44. ->
  45. -> SPEC     generateE( absy, sourcename, desthandle )
  46. -> DESC     Generates the E sourcecode corresponding to the C source
  47. -> ARGS     {absy}        :   Tree containing the parsed structure of the C source
  48. ->          {sourcename}  :   Name of the C-Header
  49. ->          {desthandle}  :   BCPL pointer where the source will be written to
  50. -> PRE      {absy} <> NIL, {sourcename} <> NIL, {desthandle} <> NIL
  51. -> POST     true
  52. ->
  53. EXPORT PROC generateE( gen_absy : PTR TO includefile, gen_source, gen_output )
  54.  
  55.   PrintF( 'Generating...\n' )
  56.  
  57.   displayGauge()
  58.  
  59.   storeHeader( FilePart( gen_source ), gen_output )
  60.   writeSource( gen_absy, gen_output )
  61.  
  62. ENDPROC
  63. -><
  64.  
  65.  
  66. /* -- --------------------------------------------------------------- -- *
  67.  * --                         Private Functions                       -- *
  68.  * -- --------------------------------------------------------------- -- */
  69.  
  70. ->> PROC storeHeader()
  71. ->
  72. -> SPEC     storeHeader( filename, desthandle )
  73. -> DESC     Stores a simple header at the top of the sourcefile
  74. -> ARGS     {filename}    :   Name of the C-Header (only filepart)
  75. ->          {desthandle}  :   BCPL pointer where the source will be written to
  76. -> PRE      {filename} <> NIL, desthandle <> NIL
  77. -> POST     true
  78. ->
  79. PROC storeHeader( sto_filename, sto_output )
  80. DEF sto_buffer [46] : STRING
  81. DEF sto_len
  82.  
  83.   displayGauge()
  84.  
  85.   FOR sto_len := 0 TO 44 DO sto_buffer [ sto_len ] := " "
  86.  
  87.   sto_len                := 45 - StrLen( sto_filename )
  88.   sto_buffer [ sto_len ] := 0
  89.  
  90.   VfPrintf( sto_output , '\s'                , [ { lab_header_top } ] )
  91.   VfPrintf( sto_output , ' * -- \s\s -- *\n' , [ sto_filename       , sto_buffer ] )
  92.   VfPrintf( sto_output , '\s'                , [ { lab_header_end } ] )
  93.  
  94. ENDPROC
  95. -><
  96.  
  97. ->> PROC writeSource()
  98. ->
  99. -> SPEC     writeSource( includefile, desthandle )
  100. -> DESC     This is the function which does the main stuff.
  101. -> ARGS     {includefile} :   A tree containing the parsed structure of the C source
  102. ->          {desthandle}  :   BCPL pointer where the source will be written to
  103. -> PRE      {includefile} <> NIL, {desthandle} <> NIL
  104. -> POST     true
  105. ->
  106. PROC writeSource( wri_absy : PTR TO absy, wri_destfile )
  107. DEF wri_variant
  108.  
  109.   /*
  110.    * This function generates the source according to
  111.    * the current absy-variant. As you can see there
  112.    * are various markers for the variants with the
  113.    * following meaning:
  114.    *
  115.    *    UNREACHED    - Temporarily used ABSY-variant which doesn't occur
  116.    *                   directly or is included in another variant.
  117.    *    NYI          - Not implemented ABSY-variant.
  118.    *
  119.    */
  120.  
  121.   displayGauge()
  122.  
  123.   wri_variant := wri_absy.variant
  124.   SELECT wri_variant
  125. ->> CASE VARIANT_INCLUDEFILE
  126.   CASE VARIANT_INCLUDEFILE  ; writeIncludeFile( wri_absy, wri_destfile )
  127. -><
  128. ->> CASE VARIANT_STRUCT
  129.   CASE VARIANT_STRUCT       ; writeStruct( wri_absy, wri_destfile )
  130. -><
  131. ->> CASE VARIANT_POINTING           [   UNREACHED   ]
  132.   CASE VARIANT_POINTING     ;
  133. -><
  134. ->> CASE VARIANT_TYPE               [   UNREACHED   ]
  135.   CASE VARIANT_TYPE         ;
  136. -><
  137. ->> CASE VARIANT_ARGUMENT           [   UNREACHED   ]
  138.   CASE VARIANT_ARGUMENT     ;
  139. -><
  140. ->> CASE VARIANT_ARGS               [   UNREACHED   ]
  141.   CASE VARIANT_ARGS         ;
  142. -><
  143. ->> CASE VARIANT_FUNCTION           [   NYI         ]
  144.   CASE VARIANT_FUNCTION     ;
  145. -><
  146. ->> CASE VARIANT_EXPRESSION         [   NYI         ]
  147.   CASE VARIANT_EXPRESSION   ;
  148. -><
  149. ->> CASE VARIANT_CONSTANT
  150.   CASE VARIANT_CONSTANT     ; writeConstant( wri_absy, wri_destfile )
  151. -><
  152. ->> CASE VARIANT_INCFILE
  153.   CASE VARIANT_INCFILE      ; writeIncFile( wri_absy, wri_destfile )
  154. -><
  155. ->> CASE VARIANT_CONDITIONAL
  156.   CASE VARIANT_CONDITIONAL  ; writeConditional( wri_absy, wri_destfile )
  157. -><
  158. ->> CASE VARIANT_IDELIST            [   UNREACHED   ]
  159.   CASE VARIANT_IDELIST      ;
  160. -><
  161. ->> CASE VARIANT_COMPONENT          [   UNREACHED   ]
  162.   CASE VARIANT_COMPONENT    ;
  163. -><
  164. ->> CASE VARIANT_COMPS              [   UNREACHED   ]
  165.   CASE VARIANT_COMPS        ;
  166. -><
  167. ->> CASE VARIANT_VARIABLE           [   NYI         ]
  168.   CASE VARIANT_VARIABLE     ;
  169. -><
  170. ->> CASE VARIANT_IDEARRAYED         [   UNREACHED   ]
  171.   CASE VARIANT_IDEARRAYED   ;
  172. -><
  173. ->> CASE VARIANT_COMPRIGHT          [   UNREACHED   ]
  174.   CASE VARIANT_COMPRIGHT    ;
  175. -><
  176. ->> CASE VARIANT_CAST               [   NYI         ]
  177.   CASE VARIANT_CAST         ;
  178. -><
  179. ->> CASE VARIANT_FAULTY             [   UNUSED      ]
  180.   CASE VARIANT_FAULTY       ;
  181. -><
  182.   ENDSELECT
  183.  
  184. ENDPROC
  185. -><
  186.  
  187. ->> PROC writeIncludeFile()
  188. ->
  189. -> SPEC     writeIncludeFile( includefile, desthandle )
  190. -> DESC     This function traverses through each item of an Include-File-Block.
  191. -> ARGS     {includefile} :   A tree containing the parsed structure of the C source
  192. ->          {desthandle}  :   BCPL pointer where the source will be written to
  193. -> PRE      {includefile} <> NIL, {desthandle} <> NIL
  194. -> POST     true
  195. ->
  196. PROC writeIncludeFile( wri_includefile : PTR TO includefile, wri_destfile )
  197. DEF wri_absy : PTR TO absy
  198.  
  199.   displayGauge()
  200.  
  201.   -> Simple traversion of a double linked list.
  202.   wri_absy := wri_includefile.entries.head
  203.   WHILE wri_absy.succ <> NIL
  204.     writeSource( wri_absy, wri_destfile )
  205.     wri_absy := wri_absy.succ
  206.   ENDWHILE
  207.  
  208. ENDPROC
  209. -><
  210.  
  211. ->> PROC writeStruct()
  212. ->
  213. -> SPEC     writeStruct( struct, desthandle )
  214. -> DESC     Converts a struct-definition to an OBJECT-definition.
  215. -> ARGS     {struct}      :   Basic infos about the structure including a list of the components.
  216. ->          {desthandle}  :   BCPL pointer where the source will be written to
  217. -> PRE      {struct} <> NIL, {desthandle} <> NIL
  218. -> POST     true
  219. ->
  220. PROC writeStruct( wri_struct : PTR TO struct, wri_destfile )
  221. DEF wri_comps : PTR TO comps
  222. DEF wri_comp  : PTR TO component
  223.  
  224.   displayGauge()
  225.  
  226.   -> NOTE: The identifier must be modified to make sure that
  227.   ->       it will be accepted by the E-Compiler.
  228.   VfPrintf( wri_destfile , '\nOBJECT \s\n' , [ modifyIdentifier( wri_struct.name ) ] )
  229.  
  230.   -> Write the source for each component
  231.   wri_comps := wri_struct.components
  232.   wri_comp  := wri_comps.components.head
  233.   WHILE wri_comp.succ <> NIL
  234.     writeComponent( wri_comp, wri_destfile )
  235.     wri_comp := wri_comp.succ
  236.   ENDWHILE
  237.  
  238.   -> Here's the end of the structure
  239.   VfPrintf( wri_destfile , 'ENDOBJECT\n\n' , NIL )
  240.  
  241. ENDPROC
  242. -><
  243.  
  244. ->> PROC writeComponent()
  245. ->
  246. -> SPEC     writeComponent( component, desthandle )
  247. -> DESC     Writes the source for a structure component assuming we are writing
  248. ->          the definition of a complete structure.
  249. -> ARGS     {component}   :   Description of the component
  250. ->          {desthandle}  :   BCPL pointer where the source will be written to
  251. -> PRE      {includefile} <> NIL, {desthandle} <> NIL
  252. -> POST     true
  253. ->
  254. PROC writeComponent( wri_comp : PTR TO component, wri_destfile )
  255. DEF wri_typestring    [128] : STRING
  256. DEF wri_buffer1       [128] : STRING
  257. DEF wri_buffer2       [128] : STRING
  258. DEF wri_comment       [128] : STRING
  259. DEF wri_type                : PTR TO type
  260. DEF wri_compright           : PTR TO compright
  261. DEF wri_pointing            : PTR TO pointing
  262. DEF wri_idearrayed          : PTR TO idearrayed
  263. DEF wri_identifier, wri_times, wri_tptr
  264.  
  265.   displayGauge()
  266.  
  267.   wri_tptr := FALSE                 -> pointer declared indirectly
  268.   wri_type := wri_comp.type
  269.  
  270.  
  271.   -> Check out the corresponding type for the C-type.
  272.   -> This passage is a bit critical since some names
  273.   -> of the types are implicating a pointer declaration.
  274.   -> For better type-mapping it is needed to recognize
  275.   -> "typedef" and scan included modules. Also the list
  276.   -> must be processed in two stages, where the first
  277.   -> is used to collect all necessary informations for
  278.   -> type-mapping and the second for generating the code.
  279.  
  280.   StringF( wri_typestring, '\s', wri_type.name )
  281.   LowerStr( wri_typestring )
  282.  
  283.   IF     StrCmp( wri_typestring , 'ulong'  )
  284.     StringF( wri_typestring , 'LONG' )
  285.   ELSEIF StrCmp( wri_typestring , 'long'   )
  286.     StringF( wri_typestring , 'LONG' )
  287.   ELSEIF StrCmp( wri_typestring , 'uint'   )
  288.     StringF( wri_typestring , 'INT'  )
  289.   ELSEIF StrCmp( wri_typestring , 'int'    )
  290.     StringF( wri_typestring , 'INT'  )
  291.   ELSEIF StrCmp( wri_typestring , 'uword'  )
  292.     StringF( wri_typestring , 'INT'  )
  293.   ELSEIF StrCmp( wri_typestring , 'word'   )
  294.     StringF( wri_typestring , 'INT'  )
  295.   ELSEIF StrCmp( wri_typestring , 'uchar'  )
  296.     StringF( wri_typestring , 'CHAR' )
  297.   ELSEIF StrCmp( wri_typestring , 'char'   )
  298.     StringF( wri_typestring , 'CHAR' )
  299.   ELSEIF StrCmp( wri_typestring , 'ubyte'  )
  300.     StringF( wri_typestring , 'CHAR' )
  301.   ELSEIF StrCmp( wri_typestring , 'byte'   )
  302.     StringF( wri_typestring , 'CHAR' )
  303.   ELSEIF StrCmp( wri_typestring , 'aptr'   )
  304.     StringF( wri_typestring , 'LONG' )
  305.     wri_tptr := TRUE
  306.   ELSEIF StrCmp( wri_typestring , 'void'   )
  307.     StringF( wri_typestring , 'LONG' )
  308.   ELSEIF StrCmp( wri_typestring , 'strptr' )
  309.     StringF( wri_typestring , 'CHAR' )
  310.     wri_tptr := TRUE
  311.   ENDIF
  312.  
  313.  
  314.   -> Yeah, yeah, yeah, Arnold would say (Happy days !).
  315.   -> In a C structure you can write a type name
  316.   -> at the left side and a list of component names
  317.   -> at the other side. Each occuring component name
  318.   -> may be modified with one or more wildcards
  319.   -> denoting a pointer or it may be appended by
  320.   -> bracketpair denoting an array or it may be
  321.   -> a combination of both. Here we are traversing
  322.   -> through each component of the list.
  323.   -> A programmer who wants to keep his code in a
  324.   -> beauty way would use one line for one component !
  325.   wri_compright := wri_comp.idelist.comprights.head
  326.   WHILE wri_compright.succ <> NIL
  327.  
  328.     wri_idearrayed  := wri_compright.idearrayed
  329.     wri_pointing    := wri_compright.pointing
  330.     wri_identifier  := modifyIdentifier( wri_idearrayed.identifier )
  331.     wri_times       := wri_idearrayed.times
  332.  
  333.     StringF( wri_comment , ''     )
  334.     StringF( wri_buffer1 , '  \s' , wri_identifier )
  335.  
  336.     IF wri_tptr <> FALSE
  337.  
  338.       -> strptr     x
  339.       -> strptr    *x
  340.       -> aptr       x
  341.       -> aptr      *x
  342.  
  343.       IF wri_pointing <> NIL
  344.     StringF( wri_comment, '-> pointer to \aPTR TO \s\a', wri_typestring )
  345.     StringF( wri_buffer2, 'PTR TO LONG' )
  346.       ELSE
  347.     StringF( wri_buffer2, 'PTR TO \s', wri_typestring )
  348.       ENDIF
  349.  
  350.     ELSEIF wri_pointing <> FALSE
  351.  
  352.       -> type *x[y]
  353.       -> type *x
  354.  
  355.       IF wri_times = 0
  356.     StringF( wri_buffer2, 'PTR TO \s', wri_typestring )
  357.       ELSE
  358.     StringF( wri_comment, '-> pointer to \aPTR TO \s\a', wri_typestring )
  359.     StringF( wri_buffer2, 'PTR TO LONG' )
  360.       ENDIF
  361.  
  362.     ELSE
  363.  
  364.       -> type x[y]
  365.       -> type x
  366.  
  367.       IF wri_times = 0
  368.     StringF( wri_buffer2 , '\s'          , wri_typestring )
  369.       ELSE
  370.     StringF( wri_buffer1 , '  \s [\d]'   , wri_identifier , wri_times )
  371.     StringF( wri_buffer2 , 'ARRAY OF \s' , wri_typestring )
  372.       ENDIF
  373.  
  374.     ENDIF
  375.  
  376.     -> Now we are writing the code. Note, that the code is aligned,
  377.     -> so the generated code should be readable.
  378.     alignWrite( wri_buffer1, ALIGN_COMPONENT, wri_destfile )
  379.     VfPrintf( wri_destfile, ': ', NIL )
  380.     alignWrite( wri_buffer2, ALIGN_COMPTYPE, wri_destfile )
  381.     VfPrintf( wri_destfile, '\s\n', wri_comment )
  382.  
  383.     wri_compright   := wri_compright.succ
  384.  
  385.   ENDWHILE
  386.  
  387. ENDPROC
  388. -><
  389.  
  390. ->> PROC writeConditional()
  391. ->
  392. -> SPEC     writeConditional( cond, desthandle )
  393. -> DESC     This writes a conditional block of C-source.
  394. -> ARGS     {cond}        :   Description of the conditional block.
  395. ->          {desthandle}  :   BCPL pointer where the source will be written to
  396. -> PRE      {cond} <> NIL, {desthandle} <> NIL
  397. -> POST     true
  398. ->
  399. PROC writeConditional( wri_cond : PTR TO conditional, wri_destfile )
  400.  
  401.   -> This one isn't really done. We are always assuming that the
  402.   -> conditional code should be generated. In most cases this is
  403.   -> a good choice since C sources are often starting with something
  404.   -> like this:
  405.   ->
  406.   ->    #ifndef _MYHEADER_H_
  407.   ->    #define _MYHEADER_H_
  408.   ->     .
  409.   ->     .
  410.   ->     .
  411.   ->    #endif
  412.   ->
  413.   -> One way to make this function working properly is popping up
  414.   -> a simple requester, asking the user if we should assume the
  415.   -> macro "_MYHEADER_H_" as set or not. Another way would be the
  416.   -> one to one implementation of the C source. I would prefer the
  417.   -> primary way since the secondary would reduce the readability
  418.   -> of E sources and I don't like it to have preprocessor
  419.   -> instructions in the E code.
  420.  
  421.   displayGauge()
  422.   writeSource( wri_cond.include, wri_destfile )
  423.  
  424. ENDPROC
  425. -><
  426.  
  427. ->> PROC writeIncFile()
  428. ->
  429. -> SPEC     writeIncFile( incfile, desthandle )
  430. -> DESC     Simple structure which describes an included file.
  431. -> ARGS     {incfile}     :   Valid structure containing the included file.
  432. ->          {desthandle}  :   BCPL pointer where the source will be written to
  433. -> PRE      {incfile} <> NIL, {desthandle} <> NIL
  434. -> POST     true
  435. ->
  436. PROC writeIncFile( wri_incfile : PTR TO incfile, wri_destfile )
  437. DEF wri_current, wri_len, wri_path
  438.  
  439.   displayGauge()
  440.  
  441.   -> Kill the ".h" appendix of each include file.
  442.   -> Theoritically it should be possible to write
  443.   -> something like this in the C-code:
  444.   ->
  445.   ->  #include "mylib"
  446.   ->
  447.   -> This case would be problematic but I never
  448.   -> haven't seen this so I assume the appendix
  449.   -> ".h" is present.
  450.   ->
  451.   wri_path                  := wri_incfile.path
  452.   wri_len                   := StrLen( wri_path )
  453.   wri_path [ wri_len - 2 ]  := 0
  454.  
  455.   -> #include "x.h"         ->> MODULE '*x'
  456.   -> #include <x.h>         ->> MODULE 'x'
  457.   wri_current               := IF wri_incfile.current THEN '*' ELSE ''
  458.  
  459.   -> A way to beautify the code would be a global
  460.   -> which marks if a MODULE declaration was done.
  461.   -> This would allow to build a list of modules
  462.   -> without using the keyword MODULE everytime.
  463.   VfPrintf( wri_destfile, 'MODULE \a\s\s\a\n', [ wri_current, wri_path ] )
  464.  
  465. ENDPROC
  466. -><
  467.  
  468. ->> PROC writeConstant()
  469. ->
  470. -> SPEC     writeConstant( constant, desthandle )
  471. -> DESC     Simple structure which describes an included file.
  472. -> ARGS     {constant}    :   Constant description
  473. ->          {desthandle}  :   BCPL pointer where the source will be written to
  474. -> PRE      {constant} <> NIL, {desthandle} <> NIL
  475. -> POST     true
  476. ->
  477. PROC writeConstant( wri_const : PTR TO constant, wri_destfile )
  478. DEF wri_buffer [128] : STRING
  479. DEF wri_ident
  480.  
  481.   displayGauge()
  482.  
  483.   -> Here we are generating a valid name for the constant.
  484.   -> The first two letters must be uppercase but if an
  485.   -> underscore is present I'm making each letter until
  486.   -> the underscore uppercase. This looks better when
  487.   -> some constants are having a prefix like TAG_XXX for
  488.   -> example. The buffer of the constant will be modified
  489.   -> directly because I know that I don't need it afterwards.
  490.   wri_ident := modifyConstant( wri_const.id )
  491.   IF containsDefine( wri_const.expr )
  492.  
  493.     -> Damn, the expression contains a shift "<<" or ">>" .
  494.     -> These functions cannot be evaluated during compilation
  495.     -> which forces us to use a macro instead. This macro
  496.     -> calls the runtime function "Shl" or "Shr" .
  497.     -> A simple workaround would be the replacement of
  498.     -> "<<" with a multiplication or ">>" with a division.
  499.     -> An occuring problem would be the fact that not all
  500.     -> definitions of this kind are having a direct value.
  501.     -> Evaluating C code like "#define MYCONST  D_CONST<<E_CONST"
  502.     -> would require to know the value of E_CONST .
  503.     -> Another thing is the fact that multiplication or
  504.     -> division with big values isn't looking good and
  505.     -> it might be unclear for the reader what's the meaning
  506.     -> is. The current implementation work because it
  507.     -> uses the C like declaration but it's not optimal.
  508.  
  509.     StringF( wri_buffer, '#define \s', wri_ident )
  510.     alignWrite( wri_buffer, ALIGN_CONSTANT, wri_destfile )
  511.     VfPrintf( wri_destfile, ' ', NIL )
  512.     writeDefine( wri_const.expr, wri_destfile )
  513.  
  514.   ELSE
  515.  
  516.     -> Yeah, we can build up an expression in E comparable
  517.     -> to the one in C
  518.     StringF( wri_buffer, 'CONST \s', wri_ident )
  519.     alignWrite( wri_buffer, ALIGN_CONSTANT, wri_destfile )
  520.     VfPrintf( wri_destfile, ' = ', NIL )
  521.     writeConst( wri_const.expr, wri_destfile )
  522.  
  523.   ENDIF
  524.  
  525.   VfPrintf( wri_destfile, '\n', NIL )
  526.  
  527. ENDPROC
  528. -><
  529.  
  530. ->> PROC writeDefine()
  531. ->
  532. -> SPEC     writeDefine( expr, desthandle )
  533. -> DESC     Writes the source a simple expression
  534. -> ARGS     {expr}        :   Expression definition
  535. ->          {desthandle}  :   BCPL pointer where the source will be written to
  536. -> PRE      {expr} <> NIL, {desthandle} <> NIL
  537. -> POST     true
  538. ->
  539. PROC writeDefine( wri_expr : PTR TO expression, wri_destfile )
  540. DEF wri_extyp
  541.  
  542.   displayGauge()
  543.  
  544.   wri_extyp := wri_expr.extyp
  545.   SELECT wri_extyp
  546. ->> CASE EXTYP_ID
  547.   CASE EXTYP_ID
  548.     VfPrintf( wri_destfile, '\s', [ wri_expr.id ] )
  549. -><
  550. ->> CASE EXTYP_SIGNED
  551.   CASE EXTYP_SIGNED
  552.     VfPrintf( wri_destfile, '-', NIL )
  553.     writeDefine( wri_expr.left, wri_destfile )
  554. -><
  555. ->> CASE EXTYP_STRING
  556.   CASE EXTYP_STRING
  557.     VfPrintf( wri_destfile, '\a\s\a', [ toe( wri_expr.id ) ] )
  558. -><
  559. ->> CASE EXTYP_HEXVALUE
  560.   CASE EXTYP_HEXVALUE
  561.     VfPrintf( wri_destfile, '$\h', [ wri_expr.value ] )
  562. -><
  563. ->> CASE EXTYP_DECVALUE
  564.   CASE EXTYP_DECVALUE
  565.     VfPrintf( wri_destfile, '\d', [ wri_expr.value ] )
  566. -><
  567. ->> CASE EXTYP_NEGOTIATE
  568.   CASE EXTYP_NEGOTIATE
  569.     VfPrintf( wri_destfile, 'Not( ', NIL )
  570.     writeDefine( wri_expr.left, wri_destfile )
  571.     VfPrintf( wri_destfile, ')', NIL )
  572. -><
  573. ->> CASE EXTYP_SHIFTLEFT
  574.   CASE EXTYP_SHIFTLEFT
  575.     VfPrintf( wri_destfile, 'Shl( ', NIL )
  576.     writeDefine( wri_expr.left, wri_destfile )
  577.     VfPrintf( wri_destfile, ', ', NIL )
  578.     writeDefine( wri_expr.right, wri_destfile )
  579.     VfPrintf( wri_destfile, ' )', NIL )
  580. -><
  581. ->> CASE EXTYP_SHIFTRIGHT
  582.   CASE EXTYP_SHIFTRIGHT
  583.     VfPrintf( wri_destfile, 'Shr( ', NIL )
  584.     writeDefine( wri_expr.left, wri_destfile )
  585.     VfPrintf( wri_destfile, ', ', NIL )
  586.     writeDefine( wri_expr.right, wri_destfile )
  587.     VfPrintf( wri_destfile, ' )', NIL )
  588. -><
  589. ->> CASE EXTYP_PLUS
  590.   CASE EXTYP_PLUS
  591.     writeDefine( wri_expr.left, wri_destfile )
  592.     VfPrintf( wri_destfile, ' + ', NIL )
  593.     writeDefine( wri_expr.right, wri_destfile )
  594. -><
  595. ->> CASE EXTYP_MINUS
  596.   CASE EXTYP_MINUS
  597.     writeDefine( wri_expr.left, wri_destfile )
  598.     VfPrintf( wri_destfile, ' - ', NIL )
  599.     writeDefine( wri_expr.right, wri_destfile )
  600. -><
  601. ->> CASE EXTYP_BITAND
  602.   CASE EXTYP_BITAND
  603.     writeDefine( wri_expr.left, wri_destfile )
  604.     VfPrintf( wri_destfile, ' AND ', NIL )
  605.     writeDefine( wri_expr.right, wri_destfile )
  606. -><
  607. ->> CASE EXTYP_BITOR
  608.   CASE EXTYP_BITOR
  609.     writeDefine( wri_expr.left, wri_destfile )
  610.     VfPrintf( wri_destfile, ' OR ', NIL )
  611.     writeDefine( wri_expr.right, wri_destfile )
  612. -><
  613. ->> CASE EXTYP_MUL
  614.   CASE EXTYP_MUL
  615.     writeDefine( wri_expr.left, wri_destfile )
  616.     VfPrintf( wri_destfile, ' * ', NIL )
  617.     writeDefine( wri_expr.right, wri_destfile )
  618. -><
  619. ->> CASE EXTYP_DIV
  620.   CASE EXTYP_DIV
  621.     writeDefine( wri_expr.left, wri_destfile )
  622.     VfPrintf( wri_destfile, ' / ', NIL )
  623.     writeDefine( wri_expr.right, wri_destfile )
  624. -><
  625.   ENDSELECT
  626.  
  627. ENDPROC
  628. -><
  629.  
  630. ->> PROC writeConst()
  631. ->
  632. -> SPEC     writeDefine( expr, desthandle )
  633. -> DESC     Writes the source a simple expression
  634. ->          The difference to "writeDefine" is the fact that
  635. ->          shifting won't occur.
  636. -> ARGS     {expr}        :   Expression definition
  637. ->          {desthandle}  :   BCPL pointer where the source will be written to
  638. -> PRE      {expr} <> NIL, {desthandle} <> NIL
  639. -> POST     true
  640. ->
  641. PROC writeConst( wri_expr : PTR TO expression, wri_destfile )
  642. DEF wri_extyp
  643.  
  644.   displayGauge()
  645.  
  646.   wri_extyp := wri_expr.extyp
  647.   SELECT wri_extyp
  648. ->> CASE EXTYP_ID
  649.   CASE EXTYP_ID
  650.     VfPrintf( wri_destfile, '\s', [ wri_expr.id ] )
  651. -><
  652. ->> CASE EXTYP_SIGNED
  653.   CASE EXTYP_SIGNED
  654.     VfPrintf( wri_destfile, '-', NIL )
  655.     writeDefine( wri_expr.left, wri_destfile )
  656. -><
  657. ->> CASE EXTYP_HEXVALUE
  658.   CASE EXTYP_HEXVALUE
  659.     VfPrintf( wri_destfile, '$\h', [ wri_expr.value ] )
  660. -><
  661. ->> CASE EXTYP_DECVALUE
  662.   CASE EXTYP_DECVALUE
  663.     VfPrintf( wri_destfile, '\d', [ wri_expr.value ] )
  664. -><
  665. ->> CASE EXTYP_PLUS
  666.   CASE EXTYP_PLUS
  667.     writeDefine( wri_expr.left, wri_destfile )
  668.     VfPrintf( wri_destfile, ' + ', NIL )
  669.     writeDefine( wri_expr.right, wri_destfile )
  670. -><
  671. ->> CASE EXTYP_MINUS
  672.   CASE EXTYP_MINUS
  673.     writeDefine( wri_expr.left, wri_destfile )
  674.     VfPrintf( wri_destfile, ' - ', NIL )
  675.     writeDefine( wri_expr.right, wri_destfile )
  676. -><
  677. ->> CASE EXTYP_BITAND
  678.   CASE EXTYP_BITAND
  679.     writeDefine( wri_expr.left, wri_destfile )
  680.     VfPrintf( wri_destfile, ' AND ', NIL )
  681.     writeDefine( wri_expr.right, wri_destfile )
  682. -><
  683. ->> CASE EXTYP_BITOR
  684.   CASE EXTYP_BITOR
  685.     writeDefine( wri_expr.left, wri_destfile )
  686.     VfPrintf( wri_destfile, ' OR ', NIL )
  687.     writeDefine( wri_expr.right, wri_destfile )
  688. -><
  689. ->> CASE EXTYP_MUL
  690.   CASE EXTYP_MUL
  691.     writeDefine( wri_expr.left, wri_destfile )
  692.     VfPrintf( wri_destfile, ' * ', NIL )
  693.     writeDefine( wri_expr.right, wri_destfile )
  694. -><
  695. ->> CASE EXTYP_DIV
  696.   CASE EXTYP_DIV
  697.     writeDefine( wri_expr.left, wri_destfile )
  698.     VfPrintf( wri_destfile, ' / ', NIL )
  699.     writeDefine( wri_expr.right, wri_destfile )
  700. -><
  701.   ENDSELECT
  702.  
  703. ENDPROC
  704. -><
  705.  
  706.  
  707. /* -- --------------------------------------------------------------- -- *
  708.  * --                       Supporting functions                      -- *
  709.  * -- --------------------------------------------------------------- -- */
  710.  
  711. ->> PROC modifyIdentifier()
  712. ->
  713. -> SPEC     modifyIdentifier( buffer )
  714. -> DESC     Makes the first to characters or the string up
  715. ->          to the underscore to lowercase characters.
  716. -> ARGS     {buffer}      :   Valid changable buffer
  717. -> PRE      {buffer} <> NIL
  718. -> POST     LowerStr( {buffer} ) == LowerStr( modifyIdentifier( {buffer} ) )
  719. ->
  720. PROC modifyIdentifier( mod_ident )
  721. DEF mod_until,mod_index
  722.  
  723.   displayGauge()
  724.  
  725.   mod_until := InStr( mod_ident, '_', 0 )
  726.   IF mod_until = -1 THEN mod_until := 2
  727.   mod_until := mod_until - 1
  728.  
  729.   FOR mod_index := 0 TO mod_until
  730.  
  731.     IF (mod_ident[ mod_index ] >= "A") AND (mod_ident[ mod_index ] <= "Z")
  732.       mod_ident[ mod_index ] := mod_ident[ mod_index ] + " "
  733.     ENDIF
  734.  
  735.   ENDFOR
  736.  
  737. ENDPROC mod_ident
  738. -><
  739.  
  740. ->> PROC modifyConstant()
  741. ->
  742. -> SPEC     modifyConstant( buffer )
  743. -> DESC     Makes the first to characters or the string up
  744. ->          to the underscore to uppercase characters.
  745. -> ARGS     {buffer}      :   Valid changable buffer
  746. -> PRE      {buffer} <> NIL
  747. -> POST     LowerStr( {buffer} ) == LowerStr( modifyConstant( {buffer} ) )
  748. ->
  749. PROC modifyConstant( mod_ident )
  750. DEF mod_until,mod_index
  751.  
  752.   displayGauge()
  753.  
  754.   mod_until := InStr( mod_ident, '_', 0 )
  755.   IF mod_until = -1 THEN mod_until := 2
  756.   mod_until := mod_until - 1
  757.  
  758.   FOR mod_index := 0 TO mod_until
  759.  
  760.     IF (mod_ident[ mod_index ] >= "a") AND (mod_ident[ mod_index ] <= "z")
  761.       mod_ident[ mod_index ] := mod_ident[ mod_index ] - " "
  762.     ENDIF
  763.  
  764.   ENDFOR
  765.  
  766. ENDPROC mod_ident
  767. -><
  768.  
  769. ->> PROC containsDefine()
  770. ->
  771. -> SPEC     containsDefine( expr ) = b
  772. -> DESC     Checks whether an expression must be written using a macro or not.
  773. -> ARGS     {expr}      :   Expression tree of the C source
  774. -> PRE      {expr} <> NIL
  775. -> POST     b <=> Writing the source must be done using "#define ...."
  776. ->
  777. PROC containsDefine( con_expr : PTR TO expression )
  778. DEF con_typ
  779.  
  780.   displayGauge()
  781.  
  782.   con_typ := con_expr.extyp
  783.   SELECT con_typ
  784.   CASE EXTYP_PLUS       ; RETURN containsDefine( con_expr.left ) OR containsDefine( con_expr.right )
  785.   CASE EXTYP_MINUS      ; RETURN containsDefine( con_expr.left ) OR containsDefine( con_expr.right )
  786.   CASE EXTYP_BITAND     ; RETURN containsDefine( con_expr.left ) OR containsDefine( con_expr.right )
  787.   CASE EXTYP_BITOR      ; RETURN containsDefine( con_expr.left ) OR containsDefine( con_expr.right )
  788.   CASE EXTYP_MUL        ; RETURN containsDefine( con_expr.left ) OR containsDefine( con_expr.right )
  789.   CASE EXTYP_DIV        ; RETURN containsDefine( con_expr.left ) OR containsDefine( con_expr.right )
  790.   CASE EXTYP_SIGNED     ; RETURN containsDefine( con_expr.left )
  791.   CASE EXTYP_STRING     ; RETURN TRUE
  792.   CASE EXTYP_NEGOTIATE  ; RETURN TRUE
  793.   CASE EXTYP_SHIFTLEFT  ; RETURN TRUE
  794.   CASE EXTYP_SHIFTRIGHT ; RETURN TRUE
  795.   ENDSELECT
  796.  
  797. ENDPROC FALSE
  798. -><
  799.  
  800. ->> PROC toe()
  801. ->
  802. -> SPEC     toe( buffer ) = str
  803. -> DESC     Converts a string written in C to a style comparable in E.
  804. ->          This is required since special characters are denoted in
  805. ->          special ways. This function must be extend in future because
  806. ->          currently only processed the escape character. It replaces
  807. ->          each "\33" with "\e" .
  808. -> ARGS     {buffer}      :   Buffer containing the string
  809. -> PRE      {buffer} <> NIL
  810. -> POST     true
  811. ->
  812. PROC toe( toe_str )
  813. DEF toe_buffer [1024] : STRING
  814. DEF toe_temp   [1024] : STRING
  815. DEF toe_in,toe_new
  816.  
  817.   displayGauge()
  818.  
  819.   StringF( toe_buffer, '\s', toe_str )
  820.  
  821.   REPEAT
  822.  
  823.     toe_in := InStr( toe_buffer, '\\33', 0 )
  824.     IF toe_in <> -1
  825.  
  826.       StrCopy( toe_temp, toe_buffer, toe_in )
  827.       StrAdd( toe_temp, '\\e' )
  828.       StrAdd( toe_temp, toe_buffer + toe_in + 3 )
  829.       StringF( toe_buffer, '\s', toe_temp )
  830.  
  831.     ENDIF
  832.  
  833.   UNTIL toe_in = -1
  834.  
  835.   toe_new := String( StrLen( toe_buffer ) + 1 )
  836.   StringF( toe_new, '\s', toe_buffer )
  837.  
  838. ENDPROC toe_new
  839. -><
  840.  
  841. ->> PROC alignWrite()
  842. ->
  843. -> SPEC     alignWrite( str, val, desthandle )
  844. -> DESC     Writes the string {str} to {destfile} and prints
  845. ->          some spaces until a supplied boundary. If the
  846. ->          length of the string {str} is bigger than {val}
  847. ->          no filling spaces will be printed.
  848. -> ARGS     {str}         :   Buffer containing the string
  849. ->          {desthandle}  :   BCPL pointer where the source will be written to
  850. ->          {val}         :   Value specifying the boundary
  851. -> PRE      {str} <> NIL, {desthandle} <> NIL, 0 <= {val} <= 255
  852. -> POST     true
  853. ->
  854. PROC alignWrite( ali_str, ali_num, ali_destfile )
  855. DEF ali_buffer [ 256 ] : STRING
  856. DEF ali_index, ali_len
  857.  
  858.   displayGauge()
  859.  
  860.   ali_len := StrLen( ali_str )
  861.  
  862.   StringF( ali_buffer, '\s', ali_str )
  863.   FOR ali_index := ali_len TO 255 DO ali_buffer [ ali_index ] := " "
  864.  
  865.   ali_buffer [ ali_num ] := 0
  866.  
  867.   VfPrintf( ali_destfile, ali_buffer, NIL )
  868.  
  869. ENDPROC
  870. -><
  871.  
  872.  
  873. /* -- --------------------------------------------------------------- -- *
  874.  * --                               Data                              -- *
  875.  * -- --------------------------------------------------------------- -- */
  876.  
  877. lab_header_top:
  878. CHAR    '/* -- --------------------------------------------- -- *\n', 0
  879.  
  880. lab_header_end:
  881. CHAR    ' * -- --------------------------------------------- -- *\n'    ,
  882.     ' * -- This file was generated automatically.        -- *\n'    ,
  883.     ' * -- This was done using EMOG which is             -- *\n'    ,
  884.     ' * -- (c) Copyright by Daniel Kasmeroglu (Kasisoft) -- *\n'    ,
  885.     ' * -- --------------------------------------------- -- */\n\n' ,
  886.     'OPT MODULE         -> Generate E module\n'                     ,
  887.     'OPT PREPROCESS     -> Enable preprocessor\n'                   ,
  888.     'OPT EXPORT         -> Export all\n\n\n'                        , 0
  889.  
  890.  
  891.